00100	C******  SCMSS, A2READ, INPOUT *********** 12/1/75
00200		SUBROUTINE SCMSS
00300		COMMON /PLTR/PLT,RHT,DIS/PTR/KWDS(1)
00400		1 /MKX/KSLA,ISM,LESS,IGT,NNO(5),MINUS
00450	CC	1 STEM,STUP,NTC,PS2,RAM,RDD,ITB,POSB /JCHAR/IXX,ISEMI,IBLA
00500		COMMON/RINP/R(10,85),RPOS(2,50) /RMOD/RMODE2,SET4,IBEAM,NOSET,
00600		1 STEM,STUP,NTC,PS2,RAM,RDD,ITB,POSB
00700		1 /A2Z/LAA,LBB,A1(4),LGG,A2(6),LNN,LOH,A3(3),LSS,LTT,A4(4),LYY
00800		1 /NUM/NUM(9),N9
00900	       COMMON R2,JA,G,H,R3,U(39)/SCM/V(78),I,LCNT,STAFF,JLIST(200),REND
01000	C JLIST WILL SOMETIMES BE USED(WIPED OUT) FOR R(X,Y) OVERFLOW(>50 ITEMS.)
01100		DIMENSION RLIST(200),NOMOR(6),WARN(6),ISV(5)
01200	C  /SCX/ ALSO IN WORDS, NEWR
01350		COMMON/SCX/ICM,NEG,IDOT,IEQ,ILP,IRP,IPL,ISTAR,ICOL,ISEMI,IDB
01375		1,IBLA,JF(3),IAT,JAL(14),RB,RC,JZ,IRHY,JD,KA,KB,IZ
01400		1/STF/RSTFAC(8),RSTJ2 /LIMIT/LIMIT,ITEM,LL,IS,IX
01500		1 /FRMT/F78F(1),FA1(1),FA5(1) /IDEV/IDEV
01600		1/XRN/RN(1) /ALF/INP(72),ML /POS/POS1,POS2,PSFB
01700		COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JN,DBST
01800		1,NFLG,JXX,ISEMX,JG,VX(50),IAMP,K,KN,M,MODE,IBLX
01900	      EQUIVALENCE (VX1,VX(1)),(INP1,INP(1)),(VX2,VX(2)),(VX3,VX(3)),
02000	     1(VX4,VX(4)),(VX5,VX(5)),(JLIST,RLIST)
02100		1 ,(INP2,INP(2)),(INP3,INP(3)),(INP4,INP(4))
02200	CC	1,(ISTAR,JALPHA(8)),(ICOL,JALPHA(9)),(IRP,JALPHA(6)),
02300	CC	1(ILP,JALPHA(5)),(NEG,JALPHA(2)),(IAT,JALPHA(16)),(IDOT,
02400	CC	1JALPHA(3))
02500	C--THESE ARE IN 'RESTS' NOW.	DATA IXX/'X'/,LCNT/1/,ISEMI/';'/,IBLA/' '/
02600		JDEV=IDEV
02700		JBKUP=0
02800	C JBKUP IS TO TRAP MORE THAN ONE BACKUP IN A ROW.
02900	1177	RB=0
03000		IF(JA.NE.140)GO TO 11
03100	77	MODE=1
03200		IF(IDEV.NE.5)GO TO 177
03300	C NEXT LOOKS FOR NAME TO SAVE INPUT  (TYPE 'INn NAME')
03400		DO 1377 K=3,72
03500		L=K
03600		IZ=INP(K)
03700	1377	IF(IZ.LT.0)GO TO 2377
03800	C JUMP OUT IF LETTER FOUND FIRST
03900		NAMSC='INPUT'
04000		GO TO 3377
04100	2377	CALL NAMEXT(INP(L),NAMSC,K)
04200	3377	CALL OFILE(21,NAMSC)
04300	C12/80	WRITE(21,2114)INP
04400		CALL INPOUT
04500	C WRITE OUT 'IN' ETC.
04600	177	IBEAM=-1
04700		IZ=0
04800		POS2=0
04900		POS1=0
05000	CC	THIS IS SET IN MSX NOW ****  RMODE2=R3
05100	91	CALL TYPCRL
05200		CALL TYPSTR('STAFF=')
05300		CALL TYPFLT(STAFF)
05400		IF(SET4.EQ.999.)GO TO 911
05500	912	CALL TYPSTR('    SPACING STAFF=')
05600		CALL TYPFLT(SET4)
05700	911	CALL TYPCRL
05800		GO TO 111 
05900	
06000	11	RB=0
06100		IF(MODE.LE.2)GO TO 111
06200		IF(IDEV.NE.5)GO TO 111
06300	C SKIP IF READING AN EDIT FILE
06400		CALL DPYOUT(3)
06500		CALL ACCPOG(1)
06600		CALL DPYOUT(1)
06700	C THIS TO DISPLAY NOTE NUMS. ON DATA-DISK.
06800		GO TO 111
06900	467	IDEV=5
07000		GO TO 4333
07100	444	SET4=RA
07200		GO TO 912
07300	111	CALL SETUP
07400		IF(STUP.GE.0)GO TO 8
07500	C SKIPS IF USING SETUP ON SOME STAFF
07600		IF(POS2.NE.0)GO TO 4334
07700	C JUMP IF POS1, POS2, ETC. WERE SET UP IN FILE (* SP  ST  POS1  POS2  X)
07800	4333  	IF(IDEV.EQ.5)CALL TYPSTR('TYPE POS1, POS2, (SPC)  ')
07900		READ(IDEV,F78F,END=467)POS1,POS2,PSFB
08000	C 'REREAD' IS NEEDED BECAUSE OF SOME FORTRAN BUG!!!!!!!!!!!!!!!!!!!!!!
08100	C  DON'T USE INVIS. RESTS WITH SPACING FEATURE!!!!
08200		REREAD 2114,INP
08300	C	IF(IDEV.NE.5)GO TO 5333
08400	C	WRITE(21,2114)INP
08500		IF(IDEV.EQ.5)CALL INPOUT
08600	C12/80	IF(IDEV.EQ.5)WRITE(21,2114)INP
08700	C WRITE OUT SPACING INFO
08800	5333	CALL A2READ(K,RA)
08900		IF(K.EQ.'SP')GO TO 444
09000	C TYPE "SPn" TO SET SPACING STAFF AT THIS POINT.
09100		IF(K.EQ.IAT)GO TO 467
09200	CATCH '@' WHEN POS1 AND P2 ARE EXPECTED.
09300		IF(K.EQ.LESS)GO TO 467
09400		IF(K.NE.IGT)GO TO 567
09500		IDEV=1
09600		GO TO 4333
09700	567	IF(POS2.EQ.0)POS2=200.
09800		IF(POS1.GE.POS2)GO TO 4333
09900	C  TYPE ANY POSITIVE 3RD NUM. FOR PSUEDO-FIBONACCI SPACING OF RHYTH.
10000		IF(INP1.GT.0)GO TO 4334
10100	CCC NOW FOUND LETTER WHERE WE WANT NUMB.
10200		IF(IDEV.EQ.5)GO TO 4333
10300		CALL TYPSTR(' POS1, POS2 MISSING')
10400		CALL TYPCRL
10500		GO TO 999
10600	4334	STUP=STUP-PSFB
10700	
10800	8	CALL TYPCRL
10900	367	GO TO (1,2,3,4,5,677)MODE
11000		GO TO 80041
11100	
11200	2111	IDEV=JDEV
11300		RETURN
11400	CC168	IF(NOSET.EQ.0)RETURN
11500	
11600	80052	FORMAT(F,A4,A5,2F)
11700	267	IDEV=5
11800		IF(MODE.EQ.3)CALL NOTNUM
11900		GO TO 2111
12000	4	IF(IDEV.EQ.5)CALL TYPSTR('ADD BEAMS?  ')
12100	330	READ(IDEV,2114,END=677)INP
12200		CALL LULOOP
12300		IF(INP1.EQ.LGG)GO TO 677
12400	C  TYPE 'GO' TO PASS LATER ITEMS
12500		IF(INP1.EQ.N9.AND.INP2.EQ.INP1)GO TO 99
12600		IF(INP1.EQ.LBB)GO TO 99
12700		IF(INP1.EQ.LYY)GO TO 1
12800	C  FOR BEAMS? TYPE 'nB' INSTEAD OF 'Y' FOR AUTOMATIC.
12900		IF(INP1.EQ.LNN)GO TO 2000
13000		IF(INP1.EQ.ISEMI)GO TO 2000
13100		IF(INP1.EQ.LESS)GO TO 267
13200		IF(INP1.NE.IGT)GO TO 767
13300		IDEV=1
13400	766	GO TO(1,2,3,4,5)MODE
13500	767	IF(INP1.NE.IBLA)GO TO 5177
13600	2000	MODE=MODE+1
13700		IF(IDEV.EQ.5)WRITE(21,2114)INP4
13800		GO TO 11
13900	690	REND=1
14000		GO TO 2111
14100	3	IF(IDEV.EQ.5)CALL TYPSTR('ADD MARKS?  ')
14200		GO TO 330
14300	5	IF(IDEV.EQ.5)CALL TYPSTR('ADD SLURS?  ')
14400		GO TO 330
14500	
14600	8006	MODE=MODE+1
14700		IF(MODE.GT.5)GO TO 677
14800		IF(IDEV.NE.5)GO TO 367 
14900	C RETURN ONLY IF IN TTY MODE. (NOT READ∪NG A FILE)
15000		GO TO 2111
15100	677	IF(IDEV.NE.5)GO TO 68
15200		END FILE 21
15300		CALL TYPSTR('INPUT SAVED ON ')
15400		CALL TYPSTR(NAMSC)
15500		CALL TYPSTR('.DAT')
15600		CALL TYPCRL
15700	68	REND=-1
15800		GO TO 2111
15900	
16000	99	IF(INP3.EQ.N9)GO TO 999
16100	C ELSE GET ANOTHER CHANCE TO SAY 'NO'.  99=BACKUP,  999=ESCAPE
16200		IF(MODE.GE.4)GO TO 1999
16300		IF(JBKUP.LT.0)GO TO 199
16400		JBKUP=-1
16500		MODE=MODE-1
16600		IF(MODE.EQ.0)GO TO 999
16700		IS=ISV(MODE)
16800		GO TO 11
16900	C  INSERT BACKUP ROUTINE
17000	999	REND=99
17100		GO TO 2111
17200	C FIX BACKUPS********
17300	199	CALL TYPSTR('ONLY 1 BACKUP AT A TIME.  ')
17400	299	CALL TYPSTR('CONTINUE, THEN EDIT .DAT FILE LATER, OR TYPE 999.')
17500		CALL TYPCRL
17600		GO TO 367
17700	1999	CALL TYPSTR('CANNOT BACKUP AFTER MARKS INPUT.')
17800		CALL TYPCRL
17900		GO TO 299
18000	
18100	8015	RA=0
18200		DO 15 J=1,I-1
18300	15	RA=RA+4./V(J)
18400		K=IRHY-I+1
18500		CALL TYPSTR('TOTAL RHY=')
18600		CALL TYPFLT(RA)
18700		CALL TYPSTR(' QTRS. ')
18800		CALL TYPINT(K)
18900		CALL TYPSTR(' MORE RHYTHMS NEEDED')
19000		CALL TYPCRL
19100		IDEV=5
19200	C RETURNS TO TTY MODE IF READING A FILE WITH 'FILE' FEATURE.
19300	2	IF(IDEV.EQ.5)CALL TYPSTR('TYPE ')
19400		CALL TYPINT(IRHY)
19500		CALL TYPSTR(' RHYTHMS')
19600		CALL TYPCRL
19700	
19800	1	ISV(MODE)=IS
19900		CALL TYPE
20000	CC	IF(MODE.EQ.2)CALL RHQUIK
20100	C RHQUIK ALLOWS TYPING RHYTHMS ON BOTTOM LEVEL OF KYBD.
20200	C Z=WHOLE, X=HALF, C=QUARTER, V=EIGHTH, B=SIXTEENTH.
20300		IF(INP1.NE.IAT)GO TO 1001
20400	C '@' STARTS MODE2 INPUT
20500		IF(INP2.NE.IBLA)GO TO 1001
20600	C BUT NOT IF IT'S REALLY A MOTIVE CALL
20700		IF(IDEV.EQ.5)END FILE 21
20800	C CLOSE THE BACKUP FILE
20900		CALL PRESCN
21000		CALL IFILE(22,'MODE2')
21100		READ(22,2114)INP
21200		CALL LULOOP
21300		IDEV=22
21400	C IDEV  CHANGES BACK BEFORE RETURN TO MAIN.
21500		Z=STUP
21600		CALL SETUP
21700	C MUST RECALL SETUP BECAUSE SOME ARRAYS WERE USED IN PRESCN.(??)
21800		STUP=Z
21900		GO TO 6177
22000	1001	CALL LULOOP
22100		CALL A2READ(RA,RB)
22200		IF(RA.NE.'SP')GO TO 5177
22300		SET4=RB
22400	C CAN SET SPACER HERE
22500		GO TO 1177
22600	5177	IF(INP1.EQ.IBLA) GO TO 1
22700		IF(INP1.NE.N9)GO TO 80041
22800		IF(INP2.EQ.N9)GO TO 99
22900	C  TYPE '99' TO BACK-UP
23000	80041	IF(IDEV.EQ.5)CALL INPOUT
23100	C12/80  80041	IF(IDEV.EQ.5)WRITE(21,2114)INP
23200	6177	CALL LNEND
23300		IF(INP1.EQ.ISEMI)GO TO 7774
23400	C INP1=; MEANS UNTERMINATED LINE WAS TYPED.  GO TRY AGAIN.
23500		GO TO(333,433,533)MODE-2
23600	C GO TO MARKZ, BEAMS, SLURZ
23700		RETRO=-1.
23800		I=1
23900		PARENS=0
24000		MOT=0
24100	      JZ=1  
24200		IAMP=0
24300	C  IAMP IS 'BLANK LINE'FLAG ON PP1-3.
24400	      KL=0  
24500	      RA=0  
24600		IF(MODE.EQ.2)GO TO 2408
24700	C NEXT CHECKS FOR STAFF NUM AT FRONT OF INPUT LINE#1.
24800		IF(INP1.NE.LSS)GO TO 2408
24900		IF(INP2.NE.LTT)GO TO 2408
25000		K=1
25100		L=3
25200		IF(INP3.NE.MINUS)GO TO 1277
25300		K=-1
25400		L=4
25500	1277	STAFF=NALF(INP(L))*K
25600	2277	MLX=L+1
25700		IF(INP(MLX).NE.KSLA)GO TO 2277
25800		MLX=MLX+1
25900		GO TO 3277
26000	2408	MLX=1
26100	3277	L=-1
26200	C   GO SORT OUT THE NEW FORMAT
26300		DO 2999 K=1,72
26400		N=INP(K)
26500		IF(N.EQ.IBLA)GO TO 2999
26600		L=0 
26700		IF(N.EQ.ISTAR)GO TO 277
26800		IF(N.NE.ISEMI)GO TO 2999
26900	C  READS 72 CHARS. INCLUDING ;.
27000	277	INP(K+1)=ISEMI
27100		GO TO 1773
27200	C  --- X/Y/Z* ---  WITH NO SEMICOLON WORKS FOR THIS PROG. ONLY!
27300	2999	CONTINUE
27400	7774	CALL TYPSTR('****** TRY AGAIN ***** ')
27500		CALL TYPCRL
27600		GO TO 766
27700	CC	GO TO 1
27800	
27900	1299	IF(JZ.NE.0)GO TO 1773
28000	7773	CALL TYPE
28100	CC	IF(MODE.EQ.2)CALL RHQUIK
28200	C FOR Z=W, X=H, C=Q  RHYTHMS, ETC.
28300	
28400		IF(INP1.EQ.IBLA)GO TO 7773
28500		IF(IDEV.EQ.5)CALL INPOUT
28600	C12/80	IF(IDEV.EQ.5)WRITE(21,2114)INP
28700		CALL LULOOP
28800	77732	CALL LNEND
28900		JM=-1
29000		JZ=0
29100		GO TO 2408
29200	C   'LISTS' MUST END WITH ; 
29300	1773	JZ=0
29400		DBST=1.
29500		IF(XDBST)DBST=-DBST
29600		XDBST=0
29700	17731	ML=MLX
29800		IF(PARENS.LE.0.)GO TO 975
29900	C  PARENS=-1, OPENS; =1, CLOSES; =0, NONE
30000	3362	PARENS=0
30100		MOT=I-LMOT
30200		IF(LCNT+MOT.LT.198)GO TO 33621
30300		CALL TYPSTR(' NO ROOM FOR MOTIVE ')
30400		CALL TYPCHR(JMOT,1)
30500		CALL TYPCRL
30600		GO TO 1
30700	33621	JLIST(LCNT+1)=MOT
30800		LCNT=LCNT+2
30900		DO 2140 JG=0,MOT-1
31000	2140	RLIST(LCNT+JG)=V(LMOT+JG)
31100		LCNT=LCNT+MOT
31200		IF(IAMP)GO TO 3013
31300	C  FOR CLOSE PARENS ON LAST ITEM
31400	C   STORE MOTIVE IN RLIST ARRAY
31500	
31600	975	DO 236 JDD=ML,72
31700		JD=JDD
31800		N=INP(JD)
31900	C ((((())))) MAY 13,71 /Z (D4/E/X 2 3/) CS/ ETC.  CAN USE 26 LABELS.
32000		IF(N.EQ.ILP)GO TO 477
32100		IF(N.EQ.IRP)GO TO 477
32200		IF(N.NE.ICOL)GO TO 2361
32300	477	INP(JD)=IBLA
32400		IF(N.NE.ICOL)GO TO 1113
32500		XDBST=-1.
32600		GO TO 5362
32700	C  GO CHANGE IT TO A SEMIC.  !!! CAN'T END LINE WITH :
32800	C SO NXT NOTE WILL BE DBST (TYPE /F:A:C/ ETC.)
32900	C  DBSTS WILL BE ONLY ONE 'REP' UNIT X*0Z%~#&@
33000	1113	L=JD-1
33100	5113	IF(INP(L).NE.IBLA)GO TO 2113
33200		L=L-1
33300		GO TO 5113
33400	2113	IF(N.EQ.IRP)GO TO 3361
33500	C  ONLY ONE () AS YET,  NO NESTING
33600	1140	JMOT=INP(L)
33700	C   MOTIVE NAME
33800		DO 11401 JC=1,LCNT-1
33900		IF(JMOT.NE.JLIST(JC))GO TO 11401
34000	C  FINDS DUPLICATE IDENTIFIER
34100		CALL TYPSTR(' MOTIVIC (')
34200		CALL TYPCHR(JMOT,1)
34300		CALL TYPSTR(') USED TWICE')
34400		CALL TYPCRL
34500		JLIST(JC)=0
34600	C  ZERO OUT PREVIOUS USE OF IDENTIFIER.
34700	11401	CONTINUE
34800		JLIST(LCNT)=JMOT
34900		PARENS=-1.
35000	C   A PARENTH IS OPEN
35100		INP(L)=IBLA
35200		LMOT=I
35300	C   LMOT IS CURRENT POINT IN V ARRAY
35400		GO TO 236
35500	3361	IF(PARENS.NE.0)GO TO 33612
35600		CALL TYPSTR('PARENTH ERROR - GOING ON')
35700		CALL TYPCRL
35800	33611	INP(JD)=IBLA
35900		GO TO 236
36000	33612	PARENS=1.
36100	C   SETS PARENS CLOSED FLAG
36200		GO TO 33611
36300	C   NO INVERSIONS POSSIBLE NOW
36400	2361	IF(N.NE.IAT)GO TO 5361
36500		DO 113 L=1,72
36600		K=JD+L
36700	C   K IS USED AT 240!!!
36800		JG=INP(K)
36900		IF(JG.NE.NEG)GO TO 7113
37000		RETRO=0
37100		INP(K)=IBLA
37200		GO TO 113
37300	7113	IF(JG.NE.IBLA)GO TO 4113
37400	113	CONTINUE
37500	4113	DO 6361 L=1,LCNT
37600		IF(JG.NE.JLIST(L))GO TO 6361
37700		VX1=0
37800		DO 40 M=JD+2,72
37900		JG=INP(M)
38000		IF(JG.EQ.IBLA)GO TO 40
38100		IF(JG.EQ.KSLA)GO TO 140
38200		IF(JG.EQ.ISEMI)GO TO 140
38300		IF(JG.EQ.ISTAR)GO TO 140
38400		ML=M
38500		GO TO 240
38600	40	CONTINUE
38700	240	JC=JM
38800		JM=-1
38900		INP(K)=IBLA
39000		JN=0
39100	C   MUST BE ZERO IN SCANR
39200		CALL SCANR
39300		JM=JC
39400	140	JC=1
39500		KN=L+2
39600		M=KN+JLIST(L+1)
39700		IF(RETRO)GO TO 940
39800		KN=M-1
39900		M=L+1
40000		JC=-1
40100		RETRO=-1.
40200	
40300	940	Z=RLIST(KN)
40400		IF(VX1.EQ.0)GO TO 540
40500	C  " @Q N "  WHERE N= DIATONIC STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
40600		IF(MODE.EQ.1)GO TO 440
40700	C  MODE 1 IS NOTES, 2 IS RHY.
40800		V(I)=Z*VX1
40900		GO TO 7361
41000	440	IF(ABS(Z).GE.2000.)GO TO 540
41100	C  SKIPS NON-NOTES
41200		RB=VX1
41300		IF(Z)RB=-RB
41400	C NOW TRANSPOSES BY DIAT. STEPS ONLY 100S=FLAT, 200S=SHARP, 300S=NAT
41500	C  NEG NUMS ARE CHORD NOTES.
41600		V(I)=Z+RB
41700		GO TO 7361
41800	540	V(I)=Z
41900	7361	I=I+1
42000		KN=KN+JC
42100		IF(KN.NE.M)GO TO 940
42200	
42300		RB=V(I-1)
42400		DO 8361 LI=JD,72
42500		JG=INP(LI)
42600		INP(LI)=IBLA
42700		IF(JG.EQ.KSLA)GO TO 9361
42800		IF(JG.EQ.ISEMI)GO TO 93611
42900	8361	IF(JG.EQ.ISTAR)IAMP=-1
43000	9361	MLX=LI
43100		IF(IAMP.EQ.0)GO TO 17731
43200		JZ=-1
43300	93611	IF(IAMP)GO TO 3013
43400		GO TO 7773
43500	6361	CONTINUE
43600		CALL TYPSTR(' MOTIVIC (')
43700		CALL TYPCHR(JG,1)
43800		CALL TYPSTR(') NOT FOUND')
43900		CALL TYPCRL
44000		GO TO 11401
44100	C @@@@@@@@@@@@@@@@@@@@@@@@@@
44200	5361	IF(N.NE.KSLA)GO TO 636
44300	5362	MLX=JD+1
44400		JZ=-1
44500		INP(JD)=ISEMI
44600	436	IF(INP(MLX).NE.IBLA)GO TO 103
44700		MLX=MLX+1
44800		GO TO 436
44900	636	IF(N.EQ.ISEMI)GO TO 103
45000	936	IF(N.NE.IDOT)GO TO 736
45100		L=INP(JD+1)
45200		KL=NALF(L)
45300		IF(L.LE.0)GO TO 577
45400		IF(KL.LT.0)GO TO 577
45500		IF(KL.LE.9)GO TO 236
45600	C   JUMP IF IT'S A NUMBER
45700	577	IF(MODE.EQ.2)INP(JD)=1
45800	C :::::::::******* ↑↑↑↑ MODE #?
45900		GO TO 236
46000	C   CHANGES DOTTED RHYTHMS TO '1'S.
46100	736	IF(N.NE.ISTAR)GO TO 236
46200		IAMP=-1
46300		INP(JD)=ISEMI
46400		GO TO 103
46500	236	CONTINUE
46600	
     

00100	2114	FORMAT(72A1)
00200	CC21141	FORMAT(I,72A1)
00300	
00400	5016	IF(IAMP.GE.0)GO TO 1299
00500		IF(PARENS.NE.0)GO TO 3362
00600	C  PARENS ARE STILL OPEN?
00700		GO TO 3013
00800	103	K=INP(ML)
00900	
01000	C   LAST SECTION
01100		IF(K.EQ.ISEMI)GO TO 1014
01200	C*********** MODE #?
01300		IF(K.NE.IBLA) GO TO 1899
01400		ML=ML+1
01500		GO TO 103
01600	1899	JN=0
01700	C   MUST BE ZERO IN SCANR
01800		VX4=0
01900		NOAC=0
02000		CALL SCANR
02100	      IF(VX1.EQ.-99.)GO TO 4022
02200	C NO MORE COMPOSITES IN RHYTH.  DOTS ARE INDICATED BY 100S.
02300	C RHYTH. NUMB IS KEPT HERE.  DOTTED QUARTER IS NOW 104. DBL..=204
02400	17	IF(MODE.NE.2)GO TO 117
02500		IF(JJ.EQ.1)GO TO 117
02600		IF(VX2.EQ.0)GO TO 117
02700	C VX2=0 IF "X" IS USED.  (8X3  FORMS VX1=8, VX2=0, VX3=3)
02800		RB=0
02900		DO 2117 K=1,JJ
03000	2117	RB=RB+4./VX(K)
03100		VX1=4./RB
03200	C FOR COMPOSITE RHYTHMS. (USEFUL FOR 'WHOLE' RESTS IN 5/4, ETC.)
03300		JJ=1
03400	117	V(I)=VX1
03500		IF(VX4.EQ.0)GO TO 115
03600		IF(MODE.NE.1)GO TO 115
03700		I=I+1
03800	C  FOR + OR -.  AUTO OCTAVES, ETC.
03900		V(I)=-VX1-VX4
04000	115	IF(JJ.LE.1)GO TO 114
04100		IF(MODE.NE.1)GO TO 171
04200		IF(VX2.EQ.0)GO TO 171
04300	C  JUMP IF RHY OR 'X 4' ETC.
04400		V(I)=18000.0+VX1*10.0+VX2/10.0
04500	C  PACKS 2 METER NUMS INTO ONE SLOT (18xyz.n  xy=top, zn=bottom)
04600	114	I=I+1
04700		GO TO 5016
04800	171	JC=1
04900		JD=VX(JJ)-1
05000		I=I+1
05100		GO TO 5005
05200	1014	JD=1
05300		JC=1
05400	C  X4/ CREATES REP 1,4;  A/// CREATES REP 1,3;
05500		GO TO 5005
05600	4022      JC=VX2+.3
05700	      JD=VX3-.5
05800		IF(MODE.EQ.1)NOAC=-1
05900	C ACCIS WILL NOT!! REPEAT UNLESS 100 IS ADDED TO 1ST NUM.******6/78
06000		IF(JJ.EQ.2)JD=1
06100	C   JD=HOW MANY TIMES,  JC=HOW MANY NOTES 
06200		IF(JC.LT.100)GO TO 5005
06300	C ADD 100 TO NUM OF NOTES TO REPEAT ACCIS WITH 'REP N1, N2'.
06400		JC=JC-100
06500		NOAC=0
06600	5005	N=0
06700		DO 3005 K=I-1,1,-1
06800		IF(V(K))GO TO 3005
06900		IF(V(K).LT.3000)N=N+1
07000	C  COUNTS RESTS AND NOTES ONLY (NO CHORD NOTES)
07100	3005	IF(N.EQ.JC)GO TO 4005
07200	4005	IF(JC.GT.1)GO TO 7005
07300		IF(MODE.EQ.1)NOAC=-1
07400	C 5/76 *******   AF/// WILL CREATE AF/A//-- AN:FS/// = AN:FS/A:F// *******
07500	C  ACCIS ARE DROPPED WITH / OR Xn REPEAT.  (BUT NOT WITH 'REP' OR '/X n,n/')
07600	7005	JC=I-K
07700	C  ALL THIS IS TO FIND COMPLETE CHORDS, BARS, ETC. TO REPEAT.
07800	C  REPS WILL ONLY COUNT RHYTHMIC UNITS.!
07900		DO 1005 K=1,JD    
08000	       NL=I+JC-1  
08100	      DO 2005 L=I,NL    
08200		KN=L-JC
08300		RB=V(KN)
08400		IF(NOAC.GE.0)GO TO 2005
08500		IF(ABS(RB).GE.2000)GO TO 2005
08600	C  SKIP OVER IF NOT A NOTE
08700		RB=AMOD(RB,100.0)+1000.0
08800		IF(V(KN))RB=RB-2000.0
08900	C  DROPS ACCIS WHEN SLASH REP. OR 'X' IS USED.
09000	2005	V(L)=RB
09100	1005      I=I+JC  
09200	      GO TO 5016  
09300	
09400	3013	IF(MODE.NE.2)GO TO 771
09500		IF(I-1.NE.IRHY)GO TO 8015
09600	C  WRONG NUMBER OF ITEMS
09700	771	V(I)=-99.
09800		IF(MODE.NE.1)GO TO 132
09900	C  FOR ADDED NOTES ON SPACING STAFF
10000		CALL NOTES
10100	C SAVES TOTAL OF ITEMS FOR LABEL 168
10200	67	CALL NEWR
10300		IX=IS
10400	C SAVE PTR TO RN ARRAY FOR TREM. OVER BEAM LATER. (IN 'BEAMS.F4')
10500		GO TO 8006
10600	132	CALL RHYTH
10700	C  =50 IS RHYTHM FOR TEXT
10800		GO TO 67
10900	134	IF(IDEV.EQ.5)CALL INPOUT
11000	C12/80  134	IF(IDEV.EQ.5)WRITE(21,2114)INP
11100	C  WRITES TYPED IN REPLY TO 'ADD BEAMS?'
11200	C   ACCENTS ARE IN MARKZ SUBROUTINE
11300		GO TO 8006
11400	533	CALL SLURZ
11500		GO TO 8006
11600	433	CALL BEAMS
11700	C  ADJUSTS STEMS (IBEAM=0) IF BEAMS WERE ENTERED.
11800		IBEAM=0
11900		GO TO 8006
12000	333	CALL MARKZ
12100	135	K=IS
12200		CALL NEWR
12300		IS=K
12400	C  ↑↑↑↑↑↑ TO ADD NEW ITEMS, SUCH AS PPP, MP, CRESC., ETC.(SEE 'MARKS')
12500		GO TO 8006
12600		END
12700	
12800		SUBROUTINE A2READ(A,B)
12900		REREAD 1,A,B
13000		CALL LO2UP(A)
13100	1	FORMAT(A2,F)
13200		END
13300		SUBROUTINE INPOUT
13400	C WRITES TYPED INPUT TO FILE 'INPUT.DAT' (OR OTHER NAME)
13500		COMMON /ALF/INP(1)
13600		DO 1 K=72,1,-1
13700	1	IF(INP(K).NE.' ')GO TO 2
13800		K=1
13900	2	WRITE(21,2114)(INP(J),J=1,K)
14000	2114	FORMAT(72A1)
14100		END